home *** CD-ROM | disk | FTP | other *** search
/ Aminet 4 / Aminet 4 - November 1994.iso / aminet / comm / fido / shelter191a.lha / rexx / Read.rexx < prev    next >
OS/2 REXX Batch file  |  1994-06-25  |  7KB  |  231 lines
  1. /**/
  2. v="$VER: Read  Rexx Message Base Browser Williamson 55.06"
  3. tview="Extract"
  4. /*tview="less -[cli]"   */
  5. bbslist="CFG:READ.CFG"
  6. script="Multi-Network Reader";sv="v"||right(v,5)
  7. cr='0a'x;lf='0a'x;NL='0d'x||'0a'x;cls='0C'x||'0A'x;quote='"'
  8. log=show('p','ROOFLOG')
  9. temp="ram:"
  10. timeouts=0
  11. if ~show("L", "rexxsupport.library") then
  12.     if ~addlib("rexxsupport.library", 0, -30, 0) then do
  13.             say "Couldn't access support.library !"
  14.             exit 20
  15.     end
  16. if ~show("L", "RexxDosSupport.library") then
  17.     if ~addlib("RexxDosSupport.library", 0, -30, 0) then do
  18.             say "Couldn't access WB2 support.library !"
  19.             exit 20
  20.     end
  21.  
  22. options results
  23. options failat 20
  24. signal on halt
  25. signal on ioerr
  26. signal on break_c
  27. signal on break_d
  28.  
  29. if arg()=0 then do
  30.     debug=1
  31.     username="Beta Tester"
  32. end;else do
  33.     debug=0
  34.     baseport=GetClip('SHELTER')
  35.     if baseport="ROOF" then envpath="";else envpath=baseport"/"
  36.     auxdev=GetVar(envpath||'AUXDEV',"G")
  37.     auxmount=GetVar(envpath||'AUXMOUNT',"G")
  38.     if ~showlist("H",auxdev) then do
  39.         options failat 99999
  40.         ADDRESS COMMAND auxmount
  41.         options failat 20
  42.     end
  43.     parse arg baud port username
  44.     Address VALUE baseport||port
  45.     'String $(device) $(unit) $(locked) $(baudlocked)'
  46.     parse var RESULT device unit locked baudlocked
  47.     if log then address 'ROOFLOG' 'logline' left(time(),5) script': REDIRECT:'device unit locked baudlocked
  48.     if locked="TRUE" then redirect=GetVar(envpath||'AUXDIRECT',"G")||strip(device)'/'strip(unit)'/con/shared/checkcd/speed'||strip(baudlocked)
  49.     else redirect=GetVar(envpath||'AUXDIRECT',"G")||strip(device)'/'strip(unit)'/con/shared/checkcd/speed'||strip(baud)
  50.     if log then address 'ROOFLOG' 'logline' left(time(),5) script': REDIRECT:'redirect
  51. end
  52. /* Start Area Processing */
  53. if ~open('dlst',bbslist, 'R') then do
  54.     call send("SYSTEM ERROR: Couldn't open message areas list" bbslist||NL)
  55.     exit 10
  56. end
  57. x=upper(uprompt(' ANSI? (y/N) '))
  58. ansi=x=="Y"
  59. if ansi then do
  60. CSI='1b'x||'[';AOFF=CSI||'0m';BOLD=CSI||'1m';ITALICS=CSI||'3;40m'
  61. end;else do
  62. CSI='';AOFF='';BOLD='';ITALICS=''
  63. end
  64.  
  65. call send(cls||ITALICS||" "script sv||AOFF||NL||BOLD||" by Robert Williamson 1:167/104.0@fidonet"||AOFF||NL)
  66. /* Start Area Processing */
  67.  
  68. call send(' Reading All Network Message Areas Configuration.')
  69. area=1
  70. do while ~eof('dlst')
  71.     call send('.')
  72.     ln=strip(readln('dlst'))
  73.     if ln="" then iterate
  74.     parse var ln Path.area Network.area Name.area
  75.     if Name.area="" then do
  76.         Name.area=get_fn(Path.area)
  77.         Network.area="FreeNet"
  78.     end;else do
  79.         Name.area=strip(Name.area)
  80.         Tag.area=get_fn(Path.area)
  81.     end
  82.     area=area+1   
  83. end /*eof*/
  84. call close('dlst')
  85. areas=area-1  
  86. call send(NL||' Found 'areas' message areas'||NL)
  87.  
  88. maincmd:
  89. ucmd=uprompt(' Select Area Number, [L]ist areas, [Q]uit: ')
  90. x=upper(left(ucmd,1))
  91. if x="Q" then exit 0
  92. else if datatype(ucmd,"N") & ucmd<areas+1 then do
  93.     call showarea(ucmd)
  94.     signal maincmd
  95. end;else if x="L" then do
  96.     call send(cls)
  97.     display=1
  98.     do i=1 to areas
  99.         if length(i)=1 then call send("  "i"  "ITALICS||Left_justify(Name.i,35)||AOFF||BOLD||left_justify(Tag.i,30)||AOFF||NL)
  100.         else call send(" "i"  "||ITALICS||Left_justify(Name.i,35)||AOFF||BOLD||left_justify(Tag.i,30)||AOFF||NL)
  101.         display=display+1
  102.         if display>20 then do
  103.             ucmd=uprompt(' Select Area Number, [N]ext, [P]revious or [Q]uit: ')
  104.             if datatype(ucmd,"N") & ucmd<areas+1 then do
  105.                 call showarea(ucmd)
  106.                 signal maincmd
  107.             end
  108.             x=upper(left(ucmd,1))
  109.             if x="Q" then exit 0
  110.             else if x="N" | x="" then do
  111.                 call send(cls)
  112.                 display=1
  113.             end;else if x="P" then do
  114.                 call send(cls)
  115.                 if i>40 then i=i-40;else i=0
  116.                 display=1
  117.             end;else do
  118.                 call send('Invalid'||NL)
  119.                 signal maincmd
  120.             end
  121.         end
  122.     end
  123.     signal maincmd
  124. end
  125. signal maincmd
  126. exit 0
  127.  
  128. showarea:
  129.     area=arg(1)
  130.     path=addslash(Path.area)
  131.     call send(cls||' Scanning 'ITALICS||Network.area||AOFF' Area:'area BOLD||Name.area||AOFF)
  132.     x=showdir(Path.area,'F')
  133.     h=0
  134.     do i=1 to words(x)
  135.         nx=word(x,i)
  136.         if pos('.MSG',nx)=0 then iterate
  137.         parse var nx n '.MSG'
  138.         if n>h then h=n
  139.     end
  140.     drop x nx n
  141.     call Send(ITALICS||'    Highest:'AOFF||BOLD||h||AOFF||NL)
  142. gstart:    
  143.     mstart=uprompt(' Enter Starting Message number or [Q}uit: ')
  144.     if upper(left(mstart,1))="Q" then return
  145.     if ~datatype(mstart,"N") then signal gstart
  146.     if mstart>h | ~exists(Path||mstart||'.MSG') then do
  147.         call send(' Cannot find message 'mstart', try again'NL)
  148.         signal gstart
  149.     end
  150. gend:
  151.     mend=uprompt(' Enter Ending message or [Q]uit: ')
  152.     if upper(left(mend,1))="Q" then return
  153.     if ~datatype(mend,"N") then signal gend
  154.     if mend>h | ~exists(path||mend||'.MSG') then do
  155.         call send(' Cannot find message 'mend', highest is 'h||NL)
  156.         signal gend
  157.     end
  158.     if debug then cmd=tview Path' START 'mstart' END 'mend 
  159.     else cmd=tview redirect Path' START 'mstart' END 'mend 
  160.     address COMMAND cmd
  161.     if RC~=0 then signal gstart
  162. return
  163.  
  164. send:
  165.     if debug then call writech(STDOUT,arg(1))
  166.     else do
  167.         'Print' quote||arg(1)||quote
  168.         'Send' quote||arg(1)||quote
  169.     end
  170. return
  171.  
  172. uprompt:
  173. if debug then do
  174.     options prompt arg(1)
  175.     parse pull x
  176.     return x
  177. end;else do
  178.     'Print' quote||arg(1)||quote
  179.     'Send' quote||arg(1)||quote
  180.     'GetInbound E0 30'
  181.     'String $(event)'
  182.     if upper(RESULT)='CARRIER' then exit 10
  183.     else if upper(RESULT)='TIMEOUT' then do
  184.         timeouts=timeouts+1
  185.         if timeouts>3 then do
  186.             call send(' Sorry, too many timeouts, bye')
  187.             exit 10
  188.         end
  189.     end;else if upper(RESULT)='LOGIN' then do
  190.         'String $(namebuf)'
  191.         x=(RESULT)
  192.     end;else x=""
  193. end
  194. return x
  195.  
  196. get_fn:
  197. if LastPos('/',arg(1))~=0 then return SubStr(arg(1),LastPos('/',arg(1))+1)
  198. else if LastPos(':',arg(1))~=0 then return SubStr(arg(1),LastPos(':',arg(1))+1)
  199. else return arg(1)
  200.  
  201. addslash:
  202. curr=arg(1)
  203. select
  204.     when right(curr, 1)=":" then nop
  205.     when right(curr, 1)="/" then nop
  206.     otherwise curr=curr"/"
  207. end
  208. return curr
  209.  
  210. /* a useful procedure by Walt Sullivan  */
  211. dequote:
  212. parse arg thing
  213. parse var thing '"' unq_thing '"'
  214. if unq_thing ~= "" then return unq_thing
  215. return thing
  216.  
  217. right_justify:
  218. if length(arg(1))>arg(2) then return (right(arg(1),arg(2)))
  219. else return (copies(" ",arg(2)-length(arg(1)))||arg(1))
  220.  
  221. left_justify:
  222. if length(arg(1))>arg(2) then return (left(arg(1),arg(2)))
  223. else return (arg(1)||copies(" ",arg(2)-length(arg(1))))
  224.  
  225. halt:
  226. ioerr:
  227. break_c:
  228. break_d:
  229. exit 10
  230. /**/
  231.